home *** CD-ROM | disk | FTP | other *** search
/ Merciful 2 / Merciful - Disc 2.iso / software / h / highspeedpascalv2.0a.dms / highspeedpascalv2.0a.adf / HSPascal / AmigaDemos / MenuDemo.pas < prev    next >
Pascal/Delphi Source File  |  1991-12-31  |  5KB  |  121 lines
  1. {----------------------------------------------------------------------------
  2.  
  3.                       HighSpeed Pascal for the Amiga
  4.  
  5.                                 MENU DEMO
  6.  
  7.                    Programmed by Martin Eskildsen 1991
  8.  
  9.                    Copyright (c) 1991 by D-House I ApS
  10.                           All rights reserved
  11.  
  12.  
  13.   Version : Date (dd.mm.yy) : Comment
  14.   -----------------------------------
  15.     1.00 : 21.07.91 : First version
  16.     1.01 : 17.09.91 : Modified for new libraries
  17.     1.02 : 06.11.91 : Final for first release
  18.  
  19. ----------------------------------------------------------------------------}
  20.  
  21. program MenuDemo;
  22.  
  23. uses Init, Intuition, Exec, Graphics, MenuUtil;
  24.  
  25. var
  26.   BaseMenu : pMenu;           { The first menu in the menu strip }
  27.   m        : pMenu;           { Used temporarily }
  28.   bool     : boolean;         { Dummy }
  29.   i        : integer;         { Index }
  30.   iPtr     : pIntuiText;
  31.  
  32. procedure SelectLoop;
  33. var
  34.   dummy    : integer;
  35.   Imessage : pIntuiMessage;   { The messages sent to this program }
  36.   class    : integer;         { Message class }
  37.   code     : integer;         { Message code }
  38.   quit     : boolean;         { TRUE = done showing menu }
  39.   mNum     : integer;         { Menu number selected }
  40.   iNum     : integer;         { Item number selected }
  41.   s        : string;          { A string }
  42.   ItemPtr  : pMenuItem;       { Pointer to a menu item structure }
  43.   TextPtr  : pIntuiText;      { Pointer to a IntuiText structure }
  44.  
  45. begin
  46.   quit := FALSE;                           { Not done yet }
  47.   repeat
  48.     dummy := Wait(BitMask(OutputWindow^.UserPort^.MP_SIGBIT));
  49.                                         { Wait for something to happen }
  50.  
  51.     Imessage := pIntuiMessage(GetMsg(OutputWindow^.UserPort));
  52.                                         { Find out what }
  53.     while Imessage <> NIL do begin
  54.       class := Imessage^.class;         { Save for later use }
  55.       code  := Imessage^.code;
  56.       ReplyMsg(pMessage(Imessage));     { Accept this message }
  57.       case class of
  58.         MENUPICK     : begin            { The right mouse key was pressed }
  59.                          if code <> MENUNULL then begin { Pointed at menu? }
  60.                            mNum := MenuNum(code);
  61.                            iNum := ItemNum(code);
  62.                            quit := (mNum = 0) and (iNum = 2);
  63.                                    { Menu 1 }     { Quit item }
  64.                            ItemPtr := pMenuItem(ItemAddress(BaseMenu, code));
  65.                            TextPtr := pIntuiText(ItemPtr^.ItemFill);
  66.                            s := 'You chose ' + RetrieveStr(TextPtr^.IText);
  67.                          end
  68.                          else s := '-- You made no selection --';
  69.                          while length(s) < 60 do s := s + ' ';
  70.                          with OutputWindow^ do begin
  71.                            Move_(RPort, 20,20);         { Where to write }
  72.                            Text_(RPort, s, length(s))   { this text }
  73.                          end
  74.                        end;
  75.         CLOSEWINDOW_ : quit := TRUE
  76.       end;
  77.       Imessage := pIntuiMessage(GetMsg(OutputWindow^.UserPort)) { Get next }
  78.     end;
  79.   until quit
  80. end;
  81.  
  82. begin
  83.   if PrepareEnvironment('Menu') then begin
  84.  
  85.     Message('First, we''ll build the menu structures');
  86.     InitMenu(BaseMenu, 'Menu 1 ');
  87.     AddItem (BaseMenu, 'Simple item',    ITEMENABLED or HIGHCOMP, $0000, #0);
  88.     AddItem (BaseMenu, 'Disabled item',                 HIGHCOMP, $0000, #0);
  89.     AddItem (BaseMenu, 'Quit          ', ITEMENABLED or HIGHCOMP
  90.                                                      or COMMSEQ , $0000, 'Q');
  91.     AddMenu (m, BaseMenu, 'Menu 2 ');
  92.     for i := 1 to 20 do
  93.       AddItem (m, 'Item ' + chr(i + ord('@')), ITEMENABLED or HIGHCOMP, $0000, #0);
  94.  
  95.     Message('Menus need a window, so let''s make one');
  96.     with OutputWinDef do                     { Tell Intuition that we want }
  97.       IDCMPflags := IDCMPflags or MENUPICK;  { menu events }
  98.     OpenOutputWindow;
  99.  
  100.     Message('Let''s attach the menu strip to the Output window');
  101.  
  102.     bool := SetMenuStrip(OutputWindow, BaseMenu);
  103.  
  104.     Inform('Now, activate the Output window and press right mouse button');
  105.     SelectLoop;
  106.     
  107.     Inform('Let''s change Menu 1 a bit. Please examine the menu');
  108.     ClearMenuStrip(OutputWindow);
  109.     iPtr := BaseMenu^.FirstItem^.ItemFill;
  110.     iPtr^.IText := CStrConstPtr('Yo! I changed!');
  111.     bool := SetMenuStrip(OutputWindow, BaseMenu);
  112.     SelectLoop;
  113.  
  114.     ClearMenuStrip(OutputWindow);
  115.     Message('How nice. The menu strip has been removed and so will the Output window');
  116.     CloseOutputWindow;
  117.  
  118.     CloseDown
  119.   end
  120. end.
  121.